home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / USEREDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-28  |  52KB  |  1,578 lines
  1. UNIT UserEdit;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ UserBrowser                                   Last changed: 28.04.96  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-96 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, OpDate, OpField, OpString, PoPTypes;
  16.  
  17. TYPE
  18.   KeyType  = RECORD
  19.                Lo,Hi:   SmallWord;
  20.              END;
  21.  
  22.   DiverseType=RECORD
  23.     TempDate, TempDate2   : DateString;
  24.     TempTime    : Time;
  25.   END;
  26.  
  27. {--------------Maximus-------------------}
  28.  
  29. (*
  30.  
  31.  
  32. /* Masks for usr.bits1, below */
  33.  
  34. #define BITS_HOTKEYS     0x0001 /* Hotkeys, independent of HOTFLASH level   */
  35. #define BITS_NOTAVAIL    0x0002 /* If set, user is NOT normally available   *
  36.                                  * for chat.                                */
  37. #define BITS_FSR         0x0004 /* Full-screen reading in msg areas         */
  38. #define BITS_NERD        0x0008 /* Yelling makes no noise on sysop console  */
  39. #define BITS_NOULIST     0x0010 /* Don't display name in userlist           */
  40. #define BITS_TABS        0x0020 /* Reserved                                 */
  41. #define BITS_BIT6        0x0040 /* Reserved                                 */
  42. #define BITS_BIT7        0x0080 /* Reserved                                 */
  43. #define BITS_BIT8        0x0100 /* Used to be 'usr.msg'                     */
  44. #define BITS_BIT9        0x0200 /* Used to be 'usr.msg'                     */
  45. #define BITS_BITA        0x0400 /* Used to be 'usr.msg'                     */
  46. #define BITS_BITB        0x0800 /* Used to be 'usr.msg'                     */
  47. #define BITS_BITC        0x1000 /* Used to be 'usr.msg'                     */
  48. #define BITS_BITD        0x2000 /* Used to be 'usr.msg'                     */
  49. #define BITS_BITE        0x4000 /* Used to be 'usr.msg'                     */
  50. #define BITS_BITF        0x8000 /* Used to be 'usr.msg'                     */
  51.  
  52.  
  53. /* Masks for usr.bits2, below */
  54.  
  55. #define BITS2_BADLOGON   0x0001 /* MAX: if user's last logon attempt was bad*/
  56. #define BITS2_IBMCHARS   0x0002 /* MAX: if user can receive high-bit chars  */
  57. #define BITS2_RSVD1      0x0004 /* MAX: *obsolete* 1.02 avatar flag         */
  58. #define BITS2_BORED      0x0008 /* Use the line-oriented editor             */
  59. #define BITS2_MORE       0x0010 /* Wants the "MORE?" prompt                 */
  60. #define BITS2_RSVD2      0x0020 /* OPUS: set=wants Ansi                     */
  61. #define BITS2_CONFIGURED 0x0040 /* OPUS: set=used Maximus before            */
  62. #define BITS2_CLS        0x0080 /* OPUS: set=transmit ^L, clear=ignore ^L   */
  63. #define BITS2_BIT8       0x0100 /* used to be 'usr.keys'                    */
  64. #define BITS2_BIT9       0x0200 /* used to be 'usr.keys'                    */
  65. #define BITS2_BITA       0x0400 /* used to be 'usr.keys'                    */
  66. #define BITS2_BITB       0x0800 /* used to be 'usr.keys'                    */
  67. #define BITS2_BITC       0x1000 /* used to be 'usr.keys'                    */
  68. #define BITS2_BITD       0x2000 /* used to be 'usr.keys'                    */
  69. #define BITS2_BITE       0x4000 /* used to be 'usr.keys'                    */
  70. #define BITS2_BITF       0x8000 /* used to be 'usr.keys'                    */
  71.  
  72.  
  73. /* Masks for usr.delflag, below */
  74.  
  75. #define UFLAG_DEL   0x01
  76. #define UFLAG_PERM  0x02
  77.  
  78. /* Masks for usr.xp_flag, below */
  79.  
  80. #define XFLAG_EXPDATE    0x0001 /* Use the xp_date to control access        */
  81. #define XFLAG_EXPMINS    0x0002 /* Use the xp_mins number to control access */
  82. #define XFLAG_DEMOTE     0x0004 /* Demote user to priv level in usr.xp_priv */
  83. #define XFLAG_AXE        0x0008 /* Just hang up on user                     */
  84.  
  85. /* Constants for usr.video, below */
  86.  
  87. #define GRAPH_TTY         0x00 /* The current user's graphics setting...    */
  88. #define GRAPH_ANSI        0x01
  89. #define GRAPH_AVATAR      0x02
  90.  
  91. *)
  92.  
  93.         MaximusUserType = record
  94.           name          : String[35];    {}
  95.           city          : String[35];    {}
  96.           alias         : String[20];    {}
  97.           phone         : String[14];    {}
  98.           lastread_ptr  : SmallWord;
  99.           timeremaining : SmallWord;
  100.           pwd           : String[15];    {}
  101.           times         : SmallWord;          {}
  102.           Help          : byte;          {}
  103.           Reserved1     : array[1..2] of Byte;
  104.           video         : Byte;          {}
  105.           nulls         : Byte;
  106.           Bits          : Byte;
  107.           Reserved2     : SmallWord;{array[1..2] of Byte;}
  108.           Bits2         : SmallWord;
  109.           priv          : SmallInt;
  110.           Reserved3     : array[1..19] of Byte;
  111.           StructLen     : Byte;
  112.           Time          : SmallWord;          {}
  113.           DelFlag       : SmallWord;
  114.           Reserved4     : array[1..8] of Byte;
  115.           Width         : Byte;
  116.           Len           : Byte;
  117.           Credit        : SmallWord;
  118.           Debit         : SmallWord;
  119.           xp_priv       : SmallWord;
  120.           Union1        : LongInt;
  121.           XP_Mins       : LongInt;
  122.           XP_Flags      : Byte;
  123.           XP_Reserved   : Byte;
  124.           Ludate        : LongInt;
  125.           xKeys         : KeyType;
  126.           Lang          : byte;
  127.           DefProto      : Shortint;      {-}
  128.           Up            : LongInt;       {}
  129.           Down          : LongInt;       {}
  130.           DownToDay     : LongInt;       {}
  131.           msg           : String[9];     {}
  132.           Files         : String[9];     {}
  133.           compress      : byte;
  134.           Reserved5     : Byte;
  135.           Extra         : LongInt;
  136.           Diverse       : DiverseType;
  137.         END;
  138.  
  139.  
  140.  
  141.  
  142. {--------------QuickBBS------------------}
  143.  
  144.   FlagTYPE = RECORD
  145.               A,B,C,D: BYTE;
  146.             END;
  147.  
  148.   LASTREADType = ARRAY[1..200] of SmallInt;
  149.  
  150.   QBBSUserType = record
  151.                  Name        : String[35];
  152.                  City        : String[25];
  153.                  Pwd         : String[15];
  154.                  DataPhone,
  155.                  HomePhone   : String[12];
  156.                  LastTime    : String[5];
  157.                  LastDate    : String[8];
  158.                  Attrib      : Byte;
  159.                  Flags       : FlagType;
  160.                  Credit,
  161.                  Pending,
  162.                  TimesPosted,
  163.                  HighMsgRead,
  164.                  SecLvl,
  165.                  Times,
  166.                  Ups,
  167.                  Downs,
  168.                  UpK,
  169.                  DownK,
  170.                  TodayK      : SmallWord;
  171.                  Elapsed,
  172.                  Len         : SmallInt;
  173.                  CombinedPtr : SmallWord; (* Record number in COMBINED.BBS *)
  174.                  AliasPtr    : SmallWord; (* Record number in ALIAS.BBS    *)
  175.                  Birthday    : Longint;
  176.                  Diverse     : DiverseType;
  177.                end;
  178.  
  179.   SBBSUserType = record
  180.                  Name:               S35;
  181.                  City:               String[25];
  182.                  Password:           String[15];
  183.                  DataPhone,
  184.                  HomePhone:          String[12];
  185.                  LastTime:           String[5];
  186.                  LastDate:           String[8];
  187.                  Attrib:             Byte;
  188.                  Flags:              FlagType;
  189.                  Credit,
  190.                  Pending:            SmallInt;
  191.                  MsgsPosted,
  192.                  HighMsgRead,
  193.                  SecLvl,
  194.                  Times,
  195.                  Ups,
  196.                  Downs,
  197.                  UpK,
  198.                  DownK:              SmallWord;
  199.                  TodayK:             SmallInt;
  200.                  Elapsed:            SmallInt;
  201.                  Len:                SmallInt;
  202.                  ExtraSpace1:        Array[1..2] of byte;
  203.                  Age:                Byte;
  204.                  ExtraUserrecPtr:    SmallInt;
  205.                  ExtraSpace2:        Array[1..3] of Byte;
  206.                  Diverse     : DiverseType;
  207.                end;
  208.  
  209.     CombinedType   =ARRAY[1..200] Of boolean;
  210.  
  211.   {Extra for super-bbs}
  212.     MsgToIdxRecord = String[35];
  213.     ExtraUserRec=Record                                 (*  SUSERS.BBS  *)
  214.                Name:               MsgToIdxRecord;
  215.                Birthday:           String[8];
  216.                Attrib:             SmallWord;
  217.                Flags:              Array[1..4] of Byte; { Not yet used }
  218.                Firsttime:          String[5];
  219.                FirstDate:          String[8];
  220.                CombinedBoards:     Array[1..25]  of Byte;
  221.                SysOpComment:       String[79];
  222.                DefaultProto:       Char;                { Not yet used }
  223.                UserRecPtr:         SmallInt;
  224.                Colors:             Array[1..10] of byte;
  225.                FileListType:       Byte;                { Not yet used }
  226.                Alias:              MsgToIdxRecord;
  227.                MinutesUsed:        Longint;
  228.                ViewFileName:       String[12]; { SeeAlso attrib bits 4 - 6 }
  229.                MenuToRun:          String[8];
  230.                Timeinbank:         SmallWord;
  231.                TodayCalls:         Byte;
  232.                LanguageFileN:      String[8];  { *.LNG }
  233.                ExtraSpace:         Array[1..425] of Byte;
  234.              End;
  235.  
  236. {----------------OPUS 1.10-1.14-------------------}
  237.  
  238.     Opus110UserType=RECORD    {BBSTYPE 3} {Not fully supported!!!!!}
  239.                      Name           : String[35];
  240.                      City           : String[35];
  241.                      Pwd            : String[15];
  242.                      UsrTel         : String[15];
  243.                      Alias          : String[31];
  244.                      Times          : SmallWord;
  245.                      ClassPriv      : Byte;
  246.                      Help           : Byte;
  247.                      Tabs           : Byte;
  248.                      Language       : Byte;
  249.                      Nulls          : SmallWord;
  250.                      Msg            : SmallWord;
  251.                      Bits           : SmallWord;
  252.                      ClassLock      : Keytype;
  253.                      LuDate         : LongInt;
  254.                      Time           : SmallInt;
  255.                      Flag           : SmallWord;
  256.                      UpLd           : LongInt;
  257.                      DnLd           : LongInt;
  258.                      DnLdl          : SmallInt;
  259.                      Files          : SmallWord;
  260.                      Width          : Byte;
  261.                      Len            : Byte;
  262.                      Credit         : SmallWord;
  263.                      Debit          : SmallWord;
  264.                      SpcOEC         : String[7];
  265.                      SAccnt         : ARRAY[1..5] OF Byte;
  266.                      ExFlag         : Byte;
  267.                      XDate          : LongInt;
  268.                      CrMin          : LongInt;
  269.                      DbMin          : LongInt;
  270.                      ULikes         : String[31];
  271.                      FuDate         : LongInt;
  272.                      Reserved       : ARRAY[1..16] OF Byte;
  273.                      LastMsg        : ARRAY[1..256] OF SmallWord;
  274.                      OPUS_Id        : LongInt;
  275.                      Extern_Id      : ARRAY[1..7] OF LongInt;
  276.                      Extern_Inf     : ARRAY[1..7] OF String[31];
  277.                      Diverse        : DiverseType;
  278.                    END;
  279.  
  280. {--------Remote Access 1.11----------}
  281.  
  282.   RALASTREADrecord = array[1..200] of SmallWord;
  283.  
  284.   RAUSERSIDXrecord = record
  285.                      NameCRC32,
  286.                      HandleCRC32    : LongInt;
  287.                    end;
  288.  
  289.   RAUSERSXIrecord  = record
  290.                      Handle         : String[35];
  291.                      Comment        : String[80];
  292.                      FirstDate      : Date;
  293.                      CombinedInfo   : array[1..25] of Byte;
  294.                      BirthDate,
  295.                      SubDate        : S8;
  296.                      ScreenWidth,
  297.                      MsgArea,
  298.                      FileArea,
  299.                      Language,
  300.                      DateFormat     : Byte;
  301.                      ForwardTo      : S35;
  302.                      ExtraSpace     : Array[1..43] of Byte;
  303.                    end;
  304.  
  305.   RAUSERTYPE    = record
  306.                      Name           : S35;
  307.                      Location       : S25;
  308.                      Password       : S15;
  309.                      DataPhone,
  310.                      VoicePhone     : S12;
  311.                      LastTime       : S5;
  312.                      LastDate       : S8;
  313.                      Attribute      : Byte;
  314.  
  315.                       { Bit 0 : Deleted
  316.                             1 : Clear screen
  317.                             2 : More prompt
  318.                             3 : ANSI
  319.                             4 : No-kill
  320.                             5 : Xfer priority
  321.                             6 : Full screen msg editor
  322.                             7 : Quiet mode }
  323.  
  324.                      Flags          : FlagType;
  325.                      Credit,
  326.                      Pending        : SmallWord;
  327.                      MsgsPosted,
  328.                      LastRead,
  329.                      Security,
  330.                      NoCalls,
  331.                      Uploads,
  332.                      Downloads,
  333.                      UploadsK,
  334.                      DownloadsK     : SmallWord;
  335.                      TodayK,
  336.                      Elapsed        : SmallInt;
  337.                      ScreenLength   : SmallWord;
  338.                      LastPwdChange,
  339.                      Attribute2,
  340.  
  341.                       { Bit 0 : Hot-keys
  342.                             1 : AVT/0
  343.                             2 : Full screen message viewer
  344.                             3 : Hidden from userlist }
  345.  
  346.  
  347.                      Group          : Byte;
  348.                      XIrecord       : SmallWord;
  349.                      ExtraSpace     : array[1..3] of Byte;
  350.                      Diverse       : DiverseType;
  351.                    end;
  352.  
  353.  
  354. PROCEDURE UserEditor;
  355.  
  356. PROCEDURE IncMaxProtocol(VAR Value; ID:WORD; Factor:Integer; VAR s:STRING);
  357. PROCEDURE IncMaxVideoLevel(VAR Value; ID:WORD; Factor:Integer; VAR s:STRING);
  358. PROCEDURE IncOpusUserLevel(VAR Value; ID:WORD; Factor:Integer; VAR s:STRING);
  359. PROCEDURE IncMaximusUserLevel(VAR Value; ID:WORD; Factor:Integer; VAR s:STRING);
  360. PROCEDURE IncMaxHelpLevel(VAR Value; ID:WORD; Factor:Integer; VAR s:STRING);
  361. PROCEDURE BinConv32(EFP: EntryFieldPtr; PostEdit: Boolean);
  362. FUNCTION  ValidateBin32(EFP: EntryFieldPtr; Var ErrCode: Word; Var ErrorSt: StringPtr): Boolean;
  363.  
  364. IMPLEMENTATION
  365.  
  366. USES OpDos, OpEntry, OpCrt, OpWindow, OpCmd, OpConst, OpMenu,
  367.      OpSelect, Dos,
  368.      Globals, RBrowser, StrUtil, intercom, OproUtil, MailCfg, NetFile,
  369.      LogFile, UnixDate, Crc, Util, Resource;
  370.  
  371. VAR
  372.   ESR               : PPoPEntryScreen;
  373.   f, F2, F3, F4     : TNetFile;
  374.   up                : Pointer;
  375.  
  376.  
  377. FUNCTION MaxVideo(i:BYTE):S6;
  378. BEGIN
  379.   CASE i OF
  380.     0 : MaxVideo:='TTY';
  381.     1 : MaxVideo:='Ansi';
  382.     2 : MaxVideo:='Avatar';
  383.   END;
  384. END;
  385.  
  386. FUNCTION MaxProtocol(i:INTEGER) : S10;
  387. BEGIN
  388.   CASE i OF
  389.     -6 : MaxProtocol:='Zmodem';
  390.     -5 : MaxProtocol:='SEAlink';
  391.     -4 : MaxProtocol:='1K-Xmodem';
  392.     -3 : MaxProtocol:='Telink';
  393.     -2 : MaxProtocol:='Xmodem';
  394.     -1 : MaxProtocol:='None';
  395.   0..9 : MaxProtocol:='Extern '+Long2Str(i+1);
  396.   END;
  397. END;
  398.  
  399. FUNCTION Digits(i:BYTE):CHAR;
  400. BEGIN
  401.   CASE i OF
  402.      0.. 9 : Digits:=CHAR(48+i);
  403.     10..15 : Digits:=CHAR(55+i);
  404.   END;
  405. END;
  406.  
  407. FUNCTION PwField(i: TBBSType):WORD;
  408. BEGIN
  409.   CASE i OF
  410.     btSBBS,
  411.     btProBoard,
  412.     btOpus170,
  413.     btQBBS    : PwField:=7;
  414.     btOpus110,
  415.     btMax     : PwField:=8;
  416.     btRA      : PwField:=6;
  417.   END;
  418. END;
  419.  
  420. PROCEDURE GetAUserRec(VAR f: TNetFile; VAR Buffer; RecNum: LongInt; K,W: Boolean); far;
  421. BEGIN
  422.   f.GetRec(Buffer,RecNum, K, W);
  423. END;
  424.  
  425. PROCEDURE PutAUserRec(VAR f: TNetFile; VAR Buffer; RecNum: LongInt); far;
  426. BEGIN
  427.   f.PutRec(Buffer,RecNum);
  428. END;
  429.  
  430. PROCEDURE Edit_Combined(VAR Save:BOOLEAN);      { EDIT Combined record }
  431. VAR
  432.   cp:POINTER;
  433.   CpEsr:TPoPEntryScreen;
  434. BEGIN
  435.   Topic:=0;
  436.   GetEsr(EsrUserQBBSCombined,3,CpEsr);
  437.   WITH CpESR DO
  438.   BEGIN
  439.     cp:=GetUserRecord;
  440.     If QBBSUsertype(up^).CombinedPtr<>0 then
  441.       f3.GetRec(cp^,QBBSUsertype(up^).CombinedPtr,NoKeep,NoWait)
  442.     ELSE
  443.       FillChar(cp^,SizeOf(CombinedType),0);
  444.     Process;
  445.     If (QBBSUsertype(up^).CombinedPtr=0) then
  446.       QBBSUsertype(up^).CombinedPtr:=f3.FileSize;
  447.     If QBBSUsertype(up^).CombinedPtr<>0 then
  448.     BEGIN
  449.       f3.PutRec(cp^,QBBSUsertype(up^).CombinedPtr);
  450.       Save:=TRUE;
  451.     END;
  452.     Done;
  453.   END;
  454.   ESR^.Select;
  455. END;
  456.  
  457. PROCEDURE Edit_ExtraInfo(VAR Save:BOOLEAN);      { EDIT SBBS Extra information }
  458. VAR
  459.   cp:POINTER;
  460.   ExEsr:TPoPEntryScreen;
  461. BEGIN
  462.   Topic:=0;
  463.   GetEsr(EsrUserSBBSExtra,3,ExEsr);
  464.   WITH ExESR DO
  465.   BEGIN
  466.     cp:=GetUserRecord;
  467.     If SBBSUserType(up^).ExtraUserRecPtr>=0 then
  468.       f4.GetRec(cp^,SBBSUsertype(up^).ExtraUserRecPtr,NoKeep,NoWait)
  469.     ELSE
  470.       FillChar(cp^,SizeOf(ExtraUserRec),0);
  471.     Process;
  472.     If (SBBSUsertype(up^).ExtraUserRecPtr<0) then
  473.       SBBSUsertype(up^).ExtraUserRecPtr:=f4.FileSize;
  474.     If SBBSUsertype(up^).ExtraUserRecPtr>=0 then
  475.     BEGIN
  476.       f4.PutRec(cp^,SBBSUsertype(up^).ExtraUserRecPtr);
  477.       Save:=TRUE;
  478.     END;
  479.     Done;
  480.   END;
  481.   ESR^.Select;
  482. END;
  483.  
  484. PROCEDURE PreProcessUserRecord;         { Konverterer en record til STRINGs }
  485. VAR
  486.   Uyear, Umonth, Uday, Uhour,Umins, Usecs      : Word;
  487.   Dt:DateTime;
  488. BEGIN
  489.   CASE Cfg.BBS.BBSType OF
  490.     btQBBS,
  491.     btSBBS:
  492.        BEGIN
  493.          WITH QBBSUsertype(up^).Diverse DO
  494.          BEGIN
  495.            TempDate  :=Copy(QBBSUsertype(up^).LastDate,4,2)+'/'+Copy(QBBSUsertype(up^).LastDate,1,2)+'-'+
  496.                        Copy(QBBSUsertype(up^).LastDate,7,2);
  497. (*           UnpackUnix((QBBSUsertype(up^).Birthday),Uyear,Umonth,Uday,Uhour,Umins,Usecs);
  498.              TempDate2:=DMYToDateString('dd/mm-yy',INTEGER(Uday),INTEGER(Umonth),INTEGER(Uyear)); *)
  499.            TempTime  :=TimeStringToTime('hh:mm',QBBSUsertype(up^).LastTime);
  500.          END;
  501.        END;
  502.     btOpus110:
  503.        BEGIN
  504.          WITH Opus110UserType(up^) DO
  505.          BEGIN
  506.            Name    :=AsciiZ2Str(Name  ,35);
  507.            City    :=AsciiZ2Str(City  ,35);
  508.            Pwd     :=AsciiZ2Str(Pwd   ,15);
  509.            UsrTel  :=AsciiZ2Str(UsrTel,15);
  510.            Alias   :=AsciiZ2Str(Alias ,15);
  511.            WITH Diverse DO
  512.            BEGIN
  513.              UnpackUnix((LuDate-25200),Uyear,Umonth,Uday,Uhour,Umins,Usecs);
  514.              TempDate:=DMYToDateString('dd/mm-yy',INTEGER(Uday),INTEGER(Umonth),INTEGER(Uyear));
  515.              TempTime:=HMSToTime(BYTE(Uhour),BYTE(Umins),Byte(Usecs));
  516.            END;
  517.          END;
  518.        END;
  519.     btMax:
  520.        BEGIN
  521.          WITH MaximusUserType(up^) DO
  522.          BEGIN
  523.            Name    :=AsciiZ2Str(Name  ,35);
  524.            City    :=AsciiZ2Str(City  ,35);
  525.            Pwd     :=AsciiZ2Str(Pwd   ,15);
  526.            Phone   :=AsciiZ2Str(Phone ,14);
  527.            Alias   :=AsciiZ2Str(Alias ,20);
  528.            Fillchar(Diverse,SizeOf(DiverseType),0);
  529. {-----------------}
  530.            With Diverse do
  531.            BEGIN
  532.              Dt.Day:=LuDate AND 31;
  533.              Dt.Month:=(LuDate SHR 5) AND 15;
  534.              Dt.Year:=80+(LuDate SHR 9) AND 63;
  535.              Dt.Sec:=(LuDate SHR 15) AND 63;
  536.              Dt.Min:=(LuDate SHR 21) AND 63;
  537.              Dt.Hour:=(LuDate SHR 27) AND 31;
  538.              TempDate:=DMYToDateString('dd/mm-yy',dt.Day,dt.month,dt.year);
  539.              TempTime:=HMSToTime(Dt.Hour,Dt.Min,Dt.Min);
  540.            END;
  541. {-----------------}
  542.          END;
  543.  
  544.        End;
  545.   END;
  546. END;
  547.  
  548. PROCEDURE PostProcessUserRecord;         { Konverterer STRINGs til c-style }
  549. BEGIN
  550.   CASE Cfg.BBS.BBSType OF
  551.     btQBBS,
  552.     btSBBS:
  553.        WITH QBBSUsertype(up^).Diverse DO
  554.        BEGIN
  555.          QBBSUsertype(up^).LastTime := TimeToTimeString('hh:mm',TempTime);
  556.          QBBSUsertype(up^).LastDate := Copy(TempDate,4,2)+'-'+Copy(TempDate,1,2)+'-'+Copy(TempDate,7,2);
  557.        END;
  558.     btOpus110:
  559.        BEGIN
  560.          WITH Opus110UserType(up^) DO
  561.          BEGIN
  562.            str2AsciiZ(Name,Name,36);
  563.            Str2AsciiZ(City,City,36);
  564.            Str2AsciiZ(Pwd,Pwd,15);
  565.            Str2AsciiZ(UsrTel,UsrTel,15);
  566.            Str2AsciiZ(Alias,Alias,15);
  567.          END;
  568.        END;
  569.     btMax:
  570.        BEGIN
  571.          WITH MaximusUserType(up^) DO
  572.          BEGIN
  573.            str2AsciiZ(Name,Name,36);
  574.            Str2AsciiZ(City,City,36);
  575.            Str2AsciiZ(Pwd,Pwd,16);
  576.            Str2AsciiZ(Phone,Phone,15);
  577.            Str2AsciiZ(Alias,Alias,21);
  578.          END;
  579.        End;
  580.   END;
  581. END;
  582.  
  583.   FUNCTION OpusPriv(i:BYTE):S15;
  584.   BEGIN
  585.     CASE i OF
  586.        1 : OpusPriv:='Twit';
  587.        3 : OpusPriv:='Disgraced';
  588.        4 : OpusPriv:='Limited';
  589.        5 : OpusPriv:='Normal';
  590.        6 : OpusPriv:='Worthy';
  591.        7 : OpusPriv:='Privileged';
  592.        8 : OpusPriv:='Favored';
  593.        9 : OpusPriv:='Extra';
  594.       10 : OpusPriv:='Clerk';
  595.       11 : OpusPriv:='Assistant SysOp';
  596.       13 : OpusPriv:='SysOp';
  597.       14 : OpusPriv:='Hidden';
  598.       16 : OpusPriv:='PREREGISTERED';
  599.       ELSE OpusPriv:=' - ';
  600.     END;
  601.   END;
  602.  
  603.   FUNCTION MaximusPriv(i:BYTE):S15;
  604.   BEGIN
  605.     CASE i OF
  606.        0 : MaximusPriv:='Twit';
  607.        2 : MaximusPriv:='Disgraced';
  608.        3 : MaximusPriv:='Limited';
  609.        4 : MaximusPriv:='Normal';
  610.        5 : MaximusPriv:='Worthy';
  611.        6 : MaximusPriv:='Privileged';
  612.        7 : MaximusPriv:='Favored';
  613.        8 : MaximusPriv:='Extra';
  614.        9 : MaximusPriv:='Clerk';
  615.       10 : MaximusPriv:='Assistant SysOp';
  616.       12 : MaximusPriv:='SysOp';
  617.       13 : MaximusPriv:='Hidden';
  618.       ELSE MaximusPriv:=' - ';
  619.     END;
  620.   END;
  621.  
  622.   FUNCTION MaximusHelp(i:BYTE):S15;
  623.   BEGIN
  624.     CASE i OF
  625.        2 : MaximusHelp:='Expert';
  626.        4 : MaximusHelp:='Regular';
  627.        6 : MaximusHelp:='Novice';
  628.       32 : MaximusHelp:='Hotflash';
  629.       ELSE MaximusHelp:='---';
  630.     END;
  631.   END;
  632.  
  633. FUNCTION UserGetStr(VAR Buffer; VAR f: TNetFile):STRING; far; { Returnerer den streng der bliver }
  634. VAR                                          { Vist i browseren                 }
  635.   t,
  636.   s:STRING;
  637. BEGIN
  638.   CASE cfg.BBS.BBSType OF
  639.   btQBBS,
  640.   btSBBS:
  641.       BEGIN
  642.         With QbbsUserType(Buffer) DO
  643.         BEGIN
  644.           Str(SecLvl,t);
  645.           s:=Cpad(Name,36)+Cpad(T,16)+copy(city,1,24);
  646.         END;
  647.       END;
  648.   btOpus110:
  649.       BEGIN
  650.         WITH Opus110Usertype(buffer) DO
  651.           s:=Cpad(asciiz2str(Name,36),36)+Cpad(OpusPriv(ClassPriv DIV 16),16)+copy(AsciiZ2Str(city,36),1,24);
  652.       END;
  653.   btRA:
  654.       BEGIN
  655.         With RAUserType(Buffer) DO
  656.         BEGIN
  657.           Str(Security,t);
  658.           s:=Cpad(Name,36)+Cpad(T,16)+copy(Location,1,24);
  659.         END;
  660.       END;
  661.   btMax:
  662.       BEGIN
  663.         WITH MaximusUsertype(buffer) DO
  664.           s:=Cpad(asciiz2str(Name,36),36)+Cpad(MaximusPriv(Priv+2),16)+copy(AsciiZ2Str(city,36),1,24);
  665.       END;
  666.   END;
  667.   UserGetStr:=s;
  668. END;
  669.  
  670. PROCEDURE IncOpusUserLevel(VAR Value; ID:WORD; Factor:Integer; VAR s:STRING);
  671. BEGIN
  672.   CASE Factor OF
  673.     +1 : BEGIN
  674.            INC(byte(Value),16);
  675.            IF byte(Value)>224 THEN Byte(Value):=16;
  676.            IF byte(Value)=32  THEN Byte(Value):=48;
  677.            IF byte(Value)=192 THEN Byte(Value):=208;
  678.          END;
  679.     -1 : BEGIN
  680.            DEC(Byte(Value),16);
  681.            IF Byte(Value)<=0   THEN Byte(Value):=224;
  682.            IF Byte(Value)=32  THEN Byte(Value):=16;
  683.            IF Byte(Value)=192 THEN Byte(Value):=176;
  684.          END;
  685.   END;
  686.   s:=OpusPriv(Byte(Value) div 16);
  687. END;
  688.  
  689. PROCEDURE IncMaximusUserLevel(VAR Value; ID:WORD; Factor:Integer; VAR s:STRING);
  690. BEGIN
  691.   CASE Factor OF
  692.     +1 : BEGIN
  693.            INC(Integer(Value),1);
  694.            IF Integer(Value)=9  THEN Integer(Value):=10;
  695.            IF Integer(Value)=-1 THEN Integer(Value):=0;
  696.            IF Integer(Value)=12 THEN Integer(Value):=-2;
  697.          END;
  698.     -1 : BEGIN
  699.            DEC(Integer(Value),1);
  700.            IF Integer(Value)<=-3 THEN Integer(Value):=11;
  701.            IF Integer(Value)=9   THEN Integer(Value):=8;
  702.            IF Integer(Value)=-1  THEN Integer(Value):=-2;
  703.          END;
  704.   END;
  705.   s:=MaximusPriv(Integer(Value)+2);
  706. END;
  707.  
  708. PROCEDURE IncMaxHelpLevel(VAR Value; ID:WORD; Factor:Integer; VAR s:STRING);
  709. BEGIN
  710.   CASE Factor OF
  711.     +1 : BEGIN
  712.            INC(Integer(Value),2);
  713.            IF Integer(Value)=8  THEN Integer(Value):=32;
  714.            IF Integer(Value)=34 THEN Integer(Value):=2;
  715.          END;
  716.     -1 : BEGIN
  717.            DEC(Integer(Value),2);
  718.            IF Integer(Value)<=0 THEN Integer(Value):=32;
  719.            IF Integer(Value)=30   THEN Integer(Value):=6;
  720.          END;
  721.   END;
  722.   s:=MaximusHelp(Integer(Value));
  723. END;
  724.  
  725. PROCEDURE IncMaxVideoLevel(VAR Value; ID:WORD; Factor:Integer; VAR s:STRING);
  726. BEGIN
  727.   CASE Factor OF
  728.     +1 : BEGIN
  729.            INC(Integer(Value),1);
  730.            IF Integer(Value)=3  THEN Integer(Value):=0;
  731.          END;
  732.     -1 : BEGIN
  733.            DEC(Integer(Value),1);
  734.            IF Integer(Value)<0 THEN Integer(Value):=2;
  735.          END;
  736.   END;
  737.   s:=MaxVideo(Integer(Value));
  738. END;
  739.  
  740. PROCEDURE IncMaxProtocol(VAR Value; ID:WORD; Factor:Integer; VAR s:STRING);
  741. BEGIN
  742.   CASE Factor OF
  743.     +1 : BEGIN
  744.            INC(Integer(Value),1);
  745.            IF Integer(Value)=10  THEN Integer(Value):=-6;
  746.          END;
  747.     -1 : BEGIN
  748.            DEC(Integer(Value),1);
  749.            IF Integer(Value)<=-7 THEN Integer(Value):=10;
  750.          END;
  751.   END;
  752.   s:=MaxProtocol(Integer(Value));
  753. END;
  754.  
  755.  
  756. FUNCTION UserCRC(CONST S: STRING): LONGINT;
  757. VAR
  758.   UCRC      :LONGINT;
  759.   COUNTER   :INTEGER;
  760.   SS        :STRING;
  761. BEGIN
  762.   Ucrc := $FFFFFFFF;
  763.   SS:=TRIM(S);
  764.   FOR counter := 1 TO (Length(SS)) DO
  765.      Ucrc := UpdCrc32(BYTE(SS[counter]),Ucrc);
  766.   UserCRC:=Ucrc;
  767. END;
  768.  
  769. Procedure ShowRatio;
  770. VAR
  771.   s:S20;
  772. BEGIN
  773.   CASE Cfg.BBS.BBSType OF
  774.     btQBBS,
  775.     btSBBS:
  776.       BEGIN
  777.         If QBBSUsertype(up^).Upk <> 0 then
  778.           s:=LongIntForm('###',(QBBSUsertype(up^).Downk div QBBSUsertype(up^).UpK))
  779.         Else
  780.           s:='N/A';
  781.         FastText(s,12,64);
  782.       END;
  783.     btOpus110:
  784.       BEGIN
  785.         If Opus110UserType(up^).UpLd <> 0 then
  786.           s:=LongIntForm('###',(Opus110UserType(up^).Dnld div Opus110UserType(up^).Upld))
  787.         Else
  788.           s:='N/A';
  789.         FastText(s,13,64);
  790.        {gotoXY(61,1);}
  791.        {Write(HEXL(UserCRC(StUpCase(Opus110UserType(up^).Name))));}
  792.       END;
  793.     btRA:
  794.       BEGIN
  795.         If RaUserType(up^).UpLoadsK <> 0 then
  796.           s:=LongIntForm('###',(RaUserType(up^).DownloadsK div RaUserType(up^).UploadsK))
  797.         Else
  798.           s:='N/A';
  799.         FastText(s,12,64);
  800.        {gotoXY(61,1);
  801.        Write(HEXL(UserCRC(copy(AsciiZ2Str(RaUserType(up^).Name,35),1,Byte(RaUserType(up^).Name[0])))));}
  802.       END;
  803.     btMax:
  804.       BEGIN
  805.         If MaximusUserType(up^).Up <> 0 then
  806.           s:=LongIntForm('###',(MaximusUserType(up^).Down div MaximusUserType(up^).Up))
  807.         Else
  808.           s:='N/A';
  809.         FastText(s,13,64);
  810.       END;
  811.   END;
  812. END;
  813.  
  814. Procedure _UserPostEdit(ESP:EntryScreenPtr); far;
  815. BEGIN
  816.   IF ESP^.GetCurrentID=PwField(Cfg.BBS.BBStype) THEN
  817.   BEGIN
  818.     EntryFieldPtr(ESP^.FindField(PwField(Cfg.BBS.BBStype)))^.efOptionsOn(EfPasswordMode);
  819.     ESP^.DrawField(PwField(Cfg.BBS.BBStype));
  820.   END;
  821.   IF Esp^.CurrentFieldModified THEN Esp^.ResetScreen;
  822. END;
  823.  
  824. Procedure PreProc(ESP:EntryScreenPtr); far;
  825. BEGIN
  826.   IF ESP^.GetCurrentID=PwField(Cfg.BBS.BBStype) THEN
  827.     EntryFieldPtr(ESP^.FindField(PwField(Cfg.BBS.BBSType)))^.efOptionsOff(EfPasswordMode);
  828. END;
  829.  
  830. PROCEDURE _UserUpd(ASP: AbstractSelectorPtr); far;
  831. BEGIN
  832.   ShowRatio;
  833.   FastText(Long2Str(f.FILEPOS)+'/'+Long2Str(f.FILESIZE)+'     ',1,13);
  834. END;
  835.  
  836. PROCEDURE UserEditProc1(VAR Buffer; VAR Changed:BOOLEAN; RecNum, MaxRec: LongInt); far;
  837.  
  838.   PROCEDURE Edit_Flags;      { EDIT user Flags }
  839.   VAR
  840.     Temp  : windowptr;
  841.     InKey : Word;
  842.     m     : TPoPMenu;
  843.     key   : WORD;
  844.  
  845.     FUNCTION flagon(mask : Word) : S5;
  846.     BEGIN
  847.       IF QBBSUsertype(up^).Attrib AND mask<>0 THEN flagon:='ON ' ELSE flagon:='OFF';
  848.     END;
  849.  
  850.   BEGIN
  851.     Topic:=1;
  852.     mywin(Temp,23,8,59,16,4,'User Flags',True);
  853.     getmenu(MNUUEQBBSFlags,4,m);
  854.     MenuCommands.AddCommand(ccUser1,1,14624,0); {14624=scancode of space}
  855.     REPEAT
  856.       WITH Temp^ DO
  857.       BEGIN
  858.         wfastwrite(flagon(1),1,29,cfg.color[4].TextColor);
  859.         wfastwrite(flagon(2),2,29,cfg.color[4].TextColor);
  860.         wfastwrite(flagon(4),3,29,cfg.color[4].TextColor);
  861.         wfastwrite(flagon(8),4,29,cfg.color[4].TextColor);
  862.         wfastwrite(flagon(16),5,29,cfg.color[4].TextColor);
  863.         wfastwrite(flagon(32),6,29,cfg.color[4].TextColor);
  864.         wfastwrite(flagon(64),7,29,cfg.color[4].TextColor);
  865.       END;
  866.       M.Process;
  867.       Key:=M.MenuChoice;
  868.       CASE Key OF
  869.         1..7 : BEGIN
  870.                  IF m.GetLastCommand<>ccQuit THEN
  871.                    QBBSUsertype(up^).Attrib:=QBBSUsertype(up^).Attrib XOR (1 SHL (Key-1));
  872.                END;
  873.       END;
  874.     UNTIL m.GetLastCommand=ccQuit;
  875.     m.Done;
  876.     KillWindow(Temp);
  877.   END;
  878.  
  879.   PROCEDURE Edit_lastread;      { EDIT LastRead record }
  880.   VAR
  881.     lp:POINTER;
  882.     lresr:TPoPEntryScreen;
  883.   BEGIN
  884.     Topic:=0;
  885.     GetEsr(EsrUSERLastRead,4,lrEsr);
  886.     lp:=LrEsr.GetUserRecord;
  887.     FILLCHAR(lp^,400,0);
  888.     f2.GetRec(lp^,f.FILEPOS-1,NoKeep,NoWait);
  889.     lrEsr.Process;
  890.     f2.PutRec(lp^,f.FILEPOS-1);
  891.     lrEsr.Done;
  892.     ESR^.Select;
  893.   END;
  894.  
  895. Var
  896.   FuncKeyWin : WindowPtr;
  897.   s:S80;
  898. BEGIN
  899.   PreProcessUserRecord;
  900.   MyWin(FuncKeyWin,1,ScreenHeight-1,80,ScreenHeight,2,'',False);
  901.   WITH FuncKeyWin^, cfg.color[2] DO
  902.   BEGIN
  903.     wFastWrite('F1=Help         F2=             F3=            F4=               F5=            ',
  904.                1, 1, HighlightColor);
  905.     IF Cfg.BBS.BBSType=btQBBS THEN
  906.       s:='F9=               '
  907.     ELSE
  908.     BEGIN
  909.       s:='F9=Extra info.    ';
  910.       EntryCommands.AddCommand(ccUser9,1,Word(256*67),0);      { Edit Extra SBBS info }
  911.     END;
  912.     wFastWrite('F6=Edit Flags   F7=Edit Combin. F8=Edit Lastrd.'+s+'F0=            ',
  913.                     2,1,highlightColor);
  914.   END;
  915.   ESR^.Select;
  916.   ESR^.SetNextField(0);
  917.   ESR^.SetScreenUpdateProc(_UserUpd);
  918.   WITH EntryCommands DO
  919.   BEGIN
  920.     AddCommand(ccUser6,1,Word(256*64),0);      { Edit Bits  }
  921.     AddCommand(ccUser7,1,Word(256*65),0);      { Edit Combined }
  922.     AddCommand(ccUser8,1,Word(256*66),0);      { Edit LastRead }
  923.   END;
  924.   REPEAT
  925.     ESR^.Process;
  926.     CASE ESR^.GetLastCommand OF
  927.       ccUser6  : Edit_Flags;
  928.       ccUser7  : Edit_Combined(Changed);
  929.       ccUser8  : Edit_LastRead;
  930.       ccUser9  : Edit_ExtraInfo(Changed);
  931.     END;
  932.   UNTIL ESR^.GetLastCommand=ccQuit;
  933.   KillWindow(FuncKeyWin);
  934.   Changed:=TRUE;
  935.   PostProcessUserRecord;
  936. END;
  937.  
  938. PROCEDURE UserEditProc3(VAR Buffer; VAR Changed:BOOLEAN; RecNum,MaxRec: LongInt); far;
  939.  
  940.   PROCEDURE Edit_Flags;      { EDIT user Flags }
  941.   VAR
  942.     Temp  : windowptr;
  943.     InKey : Word;
  944.     m     : TPoPMenu;
  945.     key   : WORD;
  946.  
  947.     FUNCTION flagon(mask : Word) : S6;
  948.     BEGIN
  949.       Case Mask of
  950.         288        : BEGIN
  951.                        IF Opus110UserType(up^).bits AND mask=32 THEN
  952.                          flagon:='ANSI  '
  953.                        ELSE
  954.                        IF Opus110UserType(up^).Bits AND mask=256 THEN
  955.                          flagon:='AVATAR'
  956.                        ELSE
  957.                          flagon:='ASCII ';
  958.                      END;
  959.         4,8,64,4096,
  960.         8192,16384 : BEGIN
  961.                        IF Opus110UserType(up^).bits AND mask<>0 THEN flagon:='OFF' ELSE flagon:='ON ';
  962.                      END Else
  963.                      BEGIN
  964.                        IF Opus110UserType(up^).bits AND mask<>0 THEN flagon:='ON ' ELSE flagon:='OFF';
  965.                      END
  966.       END;
  967.     END;
  968.  
  969.   BEGIN
  970.     mywin(Temp,23,7,59,17,4,'User Flags',True);
  971.     GetMenu(MnuUEOPUS110Flags,4,m);
  972.     MenuCommands.AddCommand(ccUser1,1,14624,0); {14624=scancode of space}
  973.     REPEAT
  974.       WITH Temp^ DO
  975.       BEGIN
  976.         wfastwrite(flagon(4),1,29,cfg.color[4].TextColor);
  977.         wfastwrite(flagon(8),2,29,cfg.color[4].TextColor);
  978.         wfastwrite(flagon(16),3,29,cfg.color[4].TextColor);
  979.         wfastwrite(flagon(32+256),4,29,cfg.color[4].TextColor);
  980.         wfastwrite(flagon(64),5,29,cfg.color[4].TextColor);
  981.         wfastwrite(flagon(128),6,29,cfg.color[4].TextColor);
  982.         wfastwrite(flagon(4096),7,29,cfg.color[4].TextColor);
  983.         wfastwrite(flagon(8192),8,29,cfg.color[4].TextColor);
  984.         wfastwrite(flagon(16384),9,29,cfg.color[4].TextColor);
  985.       END;
  986.       M.Process;
  987.       Key:=M.MenuChoice;
  988.       CASE Key OF
  989.         7..9     : BEGIN
  990.                      IF m.GetLastCommand<>ccQuit THEN
  991.                        Opus110UserType(up^).bits:=Opus110UserType(up^).Bits XOR (1 SHL (Key+5));
  992.                    END;
  993.         1..3,
  994.         5,6      : BEGIN
  995.                      IF m.GetLastCommand<>ccQuit THEN
  996.                        Opus110UserType(up^).bits:=Opus110UserType(up^).Bits XOR (1 SHL (Key+1));
  997.                    END;
  998.         4        : BEGIN
  999.                      IF m.GetLastCommand<>ccQuit THEN
  1000.                      BEGIN
  1001.                        CASE (Opus110UserType(up^).Bits AND 288) OF
  1002.                          0   : Opus110UserType(up^).bits:=Opus110UserType(up^).Bits XOR 32;
  1003.                          32  : Opus110UserType(up^).bits:=Opus110UserType(up^).Bits XOR (288);
  1004.                          256 : Opus110UserType(up^).bits:=Opus110UserType(up^).Bits XOR (256);
  1005.                        END;
  1006.                      END;
  1007.                    END;
  1008.       END;
  1009.     UNTIL m.GetLastCommand=ccQuit;
  1010.     m.Done;
  1011.     KillWindow(Temp);
  1012.   END;
  1013.  
  1014. Var
  1015.   FuncKeyWin : WindowPtr;
  1016.   Ucrc,l     : Word;
  1017.   X          : Byte;
  1018. BEGIN
  1019.   PreProcessUserRecord;
  1020.   MyWin(FuncKeyWin,1,ScreenHeight-1,80,ScreenHeight,2,'',False);
  1021.   WITH FuncKeyWin^, cfg.color[2] DO
  1022.   BEGIN
  1023.     wFastWrite('F1=             F2=             F3=            F4=               F5=            ',
  1024.                     1,1,highlightColor);
  1025.     wFastWrite('F6=Edit Flags   F7=             F8=            F9=               F0=            ',
  1026.                     2,1,highlightColor);
  1027.   END;
  1028.   ESR^.Select;
  1029.   ESR^.SetNextField(0);
  1030.   ESR^.SetScreenUpdateProc(_UserUpd);
  1031.   REPEAT
  1032.     WITH EntryCommands DO
  1033.     BEGIN
  1034.       AddCommand(ccUser6,1,Word(256*64),0);      { Edit Bits  }
  1035.     END;
  1036.     ESR^.Process;
  1037.     CASE ESR^.GetLastCommand OF
  1038.       ccUser6 : Edit_Flags;
  1039.     END;
  1040.   UNTIL ESR^.GetLastCommand=ccquit;
  1041.   Changed:=TRUE;
  1042.   KillWindow(FuncKeyWin);
  1043.   PostProcessUserRecord;
  1044. END;
  1045.  
  1046. PROCEDURE UserEditProc4(VAR Buffer; VAR Changed:BOOLEAN; RecNum, MaxRec: LongInt); far;
  1047. Var
  1048.   FuncKeyWin : WindowPtr;
  1049.  
  1050.   PROCEDURE Edit_Flags;      { EDIT user Flags }
  1051.   VAR
  1052.     Temp  : windowptr;
  1053.     InKey : Word;
  1054.     m     : TPoPMenu;
  1055.     key   : WORD;
  1056.  
  1057.     FUNCTION flagon(mask : Word) : S5;
  1058.     BEGIN
  1059.       IF QBBSUsertype(up^).Attrib AND mask<>0 THEN flagon:='ON ' ELSE flagon:='OFF';
  1060.     END;
  1061.  
  1062.   BEGIN
  1063.     Topic:=1;
  1064.     mywin(Temp,23,8,59,16,4,'User Flags',True);
  1065.     getmenu(MNUUEQBBSFlags,4,m);
  1066.     MenuCommands.AddCommand(ccUser1,1,14624,0); {14624=scancode of space}
  1067.     REPEAT
  1068.       WITH Temp^ DO
  1069.       BEGIN
  1070.         wfastwrite(flagon(1),1,29,cfg.color[4].TextColor);
  1071.         wfastwrite(flagon(2),2,29,cfg.color[4].TextColor);
  1072.         wfastwrite(flagon(4),3,29,cfg.color[4].TextColor);
  1073.         wfastwrite(flagon(8),4,29,cfg.color[4].TextColor);
  1074.         wfastwrite(flagon(16),5,29,cfg.color[4].TextColor);
  1075.         wfastwrite(flagon(32),6,29,cfg.color[4].TextColor);
  1076.         wfastwrite(flagon(64),7,29,cfg.color[4].TextColor);
  1077.       END;
  1078.       M.Process;
  1079.       Key:=M.MenuChoice;
  1080.       CASE Key OF
  1081.         1..7 : BEGIN
  1082.                  IF m.GetLastCommand<>ccQuit THEN
  1083.                    QBBSUsertype(up^).Attrib:=QBBSUsertype(up^).Attrib XOR (1 SHL (Key-1));
  1084.                END;
  1085.       END;
  1086.     UNTIL m.GetLastCommand=ccQuit;
  1087.     m.Done;
  1088.     KillWindow(Temp);
  1089.   END;
  1090.  
  1091.   PROCEDURE Edit_lastread;      { EDIT lastread record }
  1092.   VAR
  1093.     ESR   : TPoPEntryScreen;
  1094.     InKey : Word;
  1095.     m     : TPoPMenu;
  1096.     x,y   : byte;
  1097.     key   : WORD;
  1098.   BEGIN
  1099.     Topic:=0;
  1100.     ESR.Process;
  1101.   END;
  1102.  
  1103. BEGIN
  1104.   PreProcessUserRecord;
  1105.   MyWin(FuncKeyWin,1,ScreenHeight-1,80,ScreenHeight,2,'',False);
  1106.   WITH FuncKeyWin^, cfg.color[2] DO
  1107.   BEGIN
  1108.     wFastWrite('F1=             F2=             F3=            F4=               F5=            ',
  1109.                     1,1,highlightColor);
  1110.     wFastWrite('F6=Edit Flags   F7=Edit Combin. F8=            F9=               F0=            ',
  1111.                     2,1,highlightColor);
  1112.   END;
  1113.   ESR^.Select;
  1114.   ESR^.SetNextField(0);
  1115.   ESR^.SetScreenUpdateProc(_UserUpd);
  1116.   REPEAT
  1117.     WITH EntryCommands DO
  1118.     BEGIN
  1119.       AddCommand(ccUser6,1,Word(256*64),0);      { Edit Bits  }
  1120.       AddCommand(ccUser7,1,Word(256*65),0);      { Edit Combined }
  1121. (*      AddCommand(ccUser8,1,Word(256*66),0);      { Edit LastRead }  *)
  1122.     END;
  1123.     ESR^.Process;
  1124.     CASE ESR^.GetLastCommand OF
  1125.       ccUser6  : Edit_Flags;
  1126.       ccUser7  : Edit_Combined(Changed);
  1127. {SA: Don't look good???????      ccUser8  : Edit_LastRead;}
  1128.     END;
  1129.   UNTIL ESR^.GetLastCommand=ccQuit;
  1130.   KillWindow(FuncKeyWin);
  1131.   Changed:=TRUE;
  1132.   PostProcessUserRecord;
  1133. END;
  1134.  
  1135.   FUNCTION Maxflagon(mask : Word) : S6;
  1136.   BEGIN
  1137.     IF MaximusUserType(up^).Bits AND mask<>0 THEN Maxflagon:='On ' ELSE Maxflagon:='Off';
  1138.   END;
  1139.  
  1140.   procedure FlagsCustomStringProc(var Name : String; Key : LongInt;
  1141.                                   Selected, Highlighted : Boolean;
  1142.                                   WPtr : RawWindowPtr); far;
  1143.   var
  1144.     s : S5;
  1145.   begin
  1146.     s:=MaxFlagOn(1 SHL (Key-1));
  1147.     Move(s[1], Name[Length(Name)-4], Length(s));
  1148.   end;
  1149.  
  1150. PROCEDURE UserEditProc7(VAR Buffer; VAR Changed:BOOLEAN; RecNum,MaxRec: LongInt); far;
  1151.  
  1152.  
  1153.   PROCEDURE Edit_Flags;      { EDIT Maximus user Flags }
  1154.   VAR
  1155.     m     : TPoPMenu;
  1156.     key   : WORD;
  1157.   BEGIN
  1158.     Topic:=199;
  1159.     GetMenu(MNUUEMaxFlags,3,m);
  1160.     M.SetCustomStringProc(FlagsCustomStringProc);
  1161.     REPEAT
  1162.       M.Process;
  1163.       Key:=M.MenuChoice;
  1164.       CASE Key OF
  1165.         1..6 : BEGIN
  1166.                   IF m.GetLastCommand<>ccQuit THEN
  1167.                   BEGIN
  1168.                     MaximusUserType(up^).Bits := MaximusUserType(up^).Bits XOR (1 SHL (Key-1));
  1169.                     Save:=True;
  1170.                   END;
  1171.                 END;
  1172.       END;
  1173.     UNTIL m.GetLastCommand=ccQuit;
  1174.     m.Done;
  1175.     Topic:=0;
  1176.   END;
  1177.  
  1178. (*
  1179.   PROCEDURE Edit_Flags;      { EDIT user Flags }
  1180.   VAR
  1181.     Temp  : windowptr;
  1182.     InKey : Word;
  1183.     m     : TPoPMenu;
  1184.     key   : WORD;
  1185.  
  1186.     FUNCTION flagon(mask : Word) : S6;
  1187.     BEGIN
  1188.       Case Mask of
  1189.         288        : BEGIN
  1190.                        IF MaximusUserType(up^).bits AND mask=32 THEN
  1191.                          flagon:='ANSI  '
  1192.                        ELSE
  1193.                        IF MaximusUserType(up^).Bits AND mask=256 THEN
  1194.                          flagon:='AVATAR'
  1195.                        ELSE
  1196.                          flagon:='ASCII ';
  1197.                      END;
  1198.         4,8,64,4096,
  1199.         8192,16384 : BEGIN
  1200.                        IF Opus110UserType(up^).bits AND mask<>0 THEN flagon:='OFF' ELSE flagon:='ON ';
  1201.                      END Else
  1202.                      BEGIN
  1203.                        IF Opus110UserType(up^).bits AND mask<>0 THEN flagon:='ON ' ELSE flagon:='OFF';
  1204.                      END
  1205.       END;
  1206.     END;
  1207.  
  1208.   BEGIN
  1209.     mywin(Temp,23,7,59,17,4,'User Flags',True);
  1210.     getmenu(MNUUEOPUS110Flags,4,m);
  1211.     MenuCommands.AddCommand(ccUser1,1,14624,0); {14624=scancode of space}
  1212.     REPEAT
  1213.       WITH Temp^ DO
  1214.       BEGIN
  1215.         wfastwrite(flagon(4),1,29,cfg.color[4].TextColor);
  1216.         wfastwrite(flagon(8),2,29,cfg.color[4].TextColor);
  1217.         wfastwrite(flagon(16),3,29,cfg.color[4].TextColor);
  1218.         wfastwrite(flagon(32+256),4,29,cfg.color[4].TextColor);
  1219.         wfastwrite(flagon(64),5,29,cfg.color[4].TextColor);
  1220.         wfastwrite(flagon(128),6,29,cfg.color[4].TextColor);
  1221.         wfastwrite(flagon(4096),7,29,cfg.color[4].TextColor);
  1222.         wfastwrite(flagon(8192),8,29,cfg.color[4].TextColor);
  1223.         wfastwrite(flagon(16384),9,29,cfg.color[4].TextColor);
  1224.       END;
  1225.       M.Process;
  1226.       Key:=M.MenuChoice;
  1227.       CASE Key OF
  1228.         7..9     : BEGIN
  1229.                      IF m.GetLastCommand<>ccQuit THEN
  1230.                        Opus110UserType(up^).bits:=Opus110UserType(up^).Bits XOR (1 SHL (Key+5));
  1231.                    END;
  1232.         1..3,
  1233.         5,6      : BEGIN
  1234.                      IF m.GetLastCommand<>ccQuit THEN
  1235.                        Opus110UserType(up^).bits:=Opus110UserType(up^).Bits XOR (1 SHL (Key+1));
  1236.                    END;
  1237.         4        : BEGIN
  1238.                      IF m.GetLastCommand<>ccQuit THEN
  1239.                      BEGIN
  1240.                        CASE (Opus110UserType(up^).Bits AND 288) OF
  1241.                          0   : Opus110UserType(up^).bits:=Opus110UserType(up^).Bits XOR 32;
  1242.                          32  : Opus110UserType(up^).bits:=Opus110UserType(up^).Bits XOR (288);
  1243.                          256 : Opus110UserType(up^).bits:=Opus110UserType(up^).Bits XOR (256);
  1244.                        END;
  1245.                      END;
  1246.                    END;
  1247.       END;
  1248.     UNTIL m.GetLastCommand=ccQuit;
  1249.     m.Done;
  1250.     KillWindow(Temp);
  1251.   END;
  1252. *)
  1253. Var
  1254.   FuncKeyWin : WindowPtr;
  1255.   Ucrc,l     : Word;
  1256.   X          : Byte;
  1257. BEGIN
  1258.   PreProcessUserRecord;
  1259.   MyWin(FuncKeyWin,1,ScreenHeight-1,80,ScreenHeight,2,'',False);
  1260.   WITH FuncKeyWin^, cfg.color[2] DO
  1261.   BEGIN
  1262.     wFastWrite('F1=             F2=             F3=            F4=               F5=            ',
  1263.                     1,1,highlightColor);
  1264.     wFastWrite('F6=Edit Flags   F7=             F8=            F9=               F0=            ',
  1265.                     2,1,highlightColor);
  1266.   END;
  1267.   ESR^.Select;
  1268.   ESR^.SetNextField(3);
  1269.   ESR^.SetScreenUpdateProc(_UserUpd);
  1270.   REPEAT
  1271. (*  WITH EntryCommands DO
  1272.     BEGIN
  1273.       AddCommand(ccUser6,1,Word(256*64),0);      { Edit Bits  }
  1274.     END;
  1275.     *)
  1276.     ESR^.Process;
  1277. (*   CASE ESR^.GetLastCommand OF
  1278.       ccUser6 : Edit_Flags;
  1279.     END;
  1280.     *)
  1281.  
  1282.   UNTIL ESR^.GetLastCommand=ccquit;
  1283.   Changed:=TRUE;
  1284.   KillWindow(FuncKeyWin);
  1285.   PostProcessUserRecord;
  1286. END;
  1287.  
  1288. PROCEDURE InitUserBuf(VAR Buffer); far;
  1289. BEGIN
  1290.   CASE cfg.BBS.BBSType OF
  1291.     btQBBS,
  1292.     btSBBS:
  1293.       BEGIN
  1294.         FILLCHAR(Buffer,SizeOf(QBBSUserType)-SizeOf(DiverseType),0);
  1295.       END;
  1296.     btOpus110:
  1297.       BEGIN
  1298.         FILLCHAR(Buffer,SizeOf(Opus110UserType)-SizeOf(DiverseType),0);
  1299.         Opus110UserType(Buffer).ClassPriv:=16;
  1300.       END;
  1301.   END;
  1302. END;
  1303.  
  1304. FUNCTION UserIsGreater(VAR r1,r2):BOOLEAN; far;  { Sorteringskriterie }
  1305. BEGIN
  1306.   CASE Cfg.BBS.BBSType OF
  1307.     btQBBS,
  1308.     btSBBS:
  1309.       UserIsGreater:=(QbbsUserType(r1).Name>QbbsUserType(r2).Name);
  1310.     btOPus110:
  1311.       UserIsGreater:=(AsciiZ2Str(Opus110UserType(r1).Name,36)>AsciiZ2Str(Opus110UserType(r2).Name,36));
  1312.   END;
  1313. END;
  1314.  
  1315. FUNCTION ReverseBinaryL(L: Keytype) : string;
  1316.   {-Return reverse binary string for LongInt (WORD*2-array)}
  1317. VAR
  1318.   I : BYTE;
  1319.   N : Byte;
  1320. BEGIN
  1321.   N := 1;
  1322.   ReverseBinaryL[0] := #32;
  1323.   FOR I := 31 DOWNTO 0 DO
  1324.   BEGIN
  1325.     CASE I OF
  1326.       0..15  : ReverseBinaryL[33-N] := Digits(Ord(L.Lo and WORD(1 shl I) <> 0)); {0 or 1}
  1327.       16..31 : ReverseBinaryL[33-N] := Digits(Ord(L.Hi and WORD(1 shl (I-16)) <> 0)); {0 or 1}
  1328.     END;
  1329.     INC(N);
  1330.   END;
  1331. END;
  1332.  
  1333. FUNCTION Str2Bin32(S: String; Var B: KEYTYPE): Boolean;
  1334.  
  1335.   FUNCTION BinMag(i:BYTE): LONGINT;
  1336.   BEGIN
  1337.     BinMag:=1 SHL (i-1);
  1338.   END;
  1339.  
  1340. VAR
  1341.   i, BinL,BinH : Word;
  1342. BEGIN
  1343.   Str2Bin32:=False;
  1344.   BinL:=0;
  1345.   BinH:=0;
  1346.   s:=LeftPadCh(s,'0',32);
  1347.   FOR i:=1 TO 32 DO
  1348.     CASE i OF
  1349.       1..16  : BEGIN
  1350.                  IF s[i]='1' THEN Inc(BinL,BinMag(i)) ELSE
  1351.                    IF s[i]<>'0' THEN Exit;
  1352.                END;
  1353.       17..32 : BEGIN
  1354.                  IF s[i]='1' THEN Inc(BinH,BinMag(i-16)) ELSE
  1355.                    IF s[i]<>'0' THEN Exit;
  1356.                END;
  1357.     END;
  1358.   Str2Bin32:=True;
  1359.   B.Lo:=BinL;
  1360.   B.Hi:=BinH;
  1361. END;
  1362.  
  1363. FUNCTION ValidateBin32(EFP: EntryFieldPtr; Var ErrCode: Word; Var ErrorSt: StringPtr): Boolean;
  1364. VAR
  1365.   B: KEYTYPE;
  1366.   S: String[80];
  1367. BEGIN
  1368.   ValidateBin32:=False;
  1369.   WITH EFP^ DO
  1370.   BEGIN
  1371.     StripPicture(efEditSt^,s);
  1372.     IF Not Str2Bin32(s,b) THEN
  1373.     BEGIN
  1374.       ErrCode:=ecBadFormat;
  1375.       ErrorSt:=@emInvalidNumber;
  1376.     END ELSE
  1377.       ValidateBin32:=True;
  1378.   END;
  1379. END;
  1380.  
  1381. PROCEDURE BinConv32(EFP: EntryFieldPtr; PostEdit: Boolean);
  1382. VAR
  1383.   s: String[80];
  1384. BEGIN
  1385.   WITH EFP^ DO
  1386.     IF PostEdit THEN
  1387.     BEGIN
  1388.       StripPicture(efEditSt^, s);
  1389.       IF Not Str2Bin32(s,KEYTYPE(efVarPtr^)) THEN LongInt(efVarPtr^):=0;
  1390.     END ELSE
  1391.     BEGIN
  1392.       s:=ReverseBinaryL(KEYTYPE(efVarPtr^));
  1393.       MergePicture(s, efEditSt^);
  1394.     END;
  1395. END;
  1396.  
  1397. FUNCTION MakeQbbsScreen: Boolean;
  1398. BEGIN
  1399.   New(ESR);
  1400.   IF ESR<>NIL THEN
  1401.   BEGIN
  1402.     IF Cfg.BBS.BBSType=btQBBS THEN GetEsr(EsrUserQBBSMain,2,ESR^)
  1403.                               ELSE GetEsr(EsrUserSBBSMain,2,ESR^);
  1404.     up:=ESR^.GetUserRecord;
  1405.     ESR^.SetPostEditProc(_UserPostEdit);
  1406.     ESR^.SetPreEditProc(PreProc);
  1407.     ESR^.SetScreenUpdateProc(_UserUpd);
  1408.     MakeQbbsScreen:=True;
  1409.   END ELSE
  1410.     MakeQbbsScreen:=False;
  1411. END;
  1412.  
  1413. FUNCTION MakeOpus110Screen: Boolean;
  1414. BEGIN
  1415.   New(ESR);
  1416.   IF ESR<>NIL THEN
  1417.   BEGIN
  1418.     GetEsr(EsrUserOPUS110Main,2,ESR^);
  1419.     up:=ESR^.GetUserRecord;
  1420.     ESR^.SetPostEditProc(_UserPostEdit);
  1421.     ESR^.SetPreEditProc(PreProc);
  1422.     ESR^.SetScreenUpdateProc(_UserUpd);
  1423.     MakeOpus110Screen:=True;
  1424.   END ELSE
  1425.     MakeOpus110Screen:=False;
  1426. END;
  1427.  
  1428. FUNCTION MakeMaximusScreen: Boolean;
  1429. BEGIN
  1430.   New(ESR);
  1431.   IF ESR<>NIL THEN
  1432.   BEGIN
  1433.     GetEsr(EsrUserMaximusMain,2,ESR^);
  1434.     up:=ESR^.GetUserRecord;
  1435.     ESR^.SetPostEditProc(_UserPostEdit);
  1436.     ESR^.SetPreEditProc(PreProc);
  1437.     ESR^.SetScreenUpdateProc(_UserUpd);
  1438.     MakeMaximusScreen:=True;
  1439.   END ELSE
  1440.     MakeMaximusScreen:=False;
  1441. END;
  1442.  
  1443. FUNCTION MakeRAScreen: Boolean;
  1444. BEGIN
  1445.   New(ESR);
  1446.   IF ESR<>NIL THEN
  1447.   BEGIN
  1448.     GetEsr(EsrUserRAMain,2,ESR^);
  1449.     up:=ESR^.GetUserRecord;
  1450.     ESR^.SetPostEditProc(_UserPOstEdit);
  1451.     ESR^.SetPreEditProc(PreProc);
  1452.     ESR^.SetScreenUpdateProc(_UserUpd);
  1453.     MakeRAScreen:=True;
  1454.   END ELSE
  1455.     MakeRAScreen:=False;
  1456. END;
  1457.  
  1458. PROCEDURE UserEditor;
  1459. VAR
  1460.   filename,
  1461.   FileName2,
  1462.   FileName3,
  1463.   FileName4 :PathStr;
  1464.   ExitCode  :WORD;
  1465. BEGIN
  1466. {$IFNDEF PoPLite}
  1467.   IF SetIntercom(IcUserEd,Call,false) THEN
  1468.   BEGIN
  1469.     CASE Cfg.BBS.BBSType OF
  1470.       btQBBS,
  1471.       btSBBS:
  1472.         BEGIN
  1473.           FileName:=Cfg.BBS.UserFile;
  1474.           FileName2:=AddBackSlash(JustPathName(cfg.BBS.UserFile))+'LASTREAD.BBS';
  1475.           FileName3:=AddBackSlash(JustPathName(cfg.BBS.UserFile))+'COMBINED.BBS';
  1476.           FileName4:=AddBackSlash(JustPathName(cfg.BBS.UserFile))+'SUSERS.BBS';
  1477.           If Not (ExistFile(FileName)) then
  1478.             AskError(8,'No Userfile Found',4)
  1479.           else
  1480.           BEGIN
  1481.             IF MakeQbbsScreen THEN
  1482.             BEGIN
  1483.               f.Open(FileName,158,True);
  1484.               f2.Open(FileName2,400,True);
  1485.               f3.Open(FileName3,200,True);
  1486.               IF Cfg.BBS.BBSType=btSBBS THEN f4.Open(FileName4,SizeOf(ExtraUserRec),True);
  1487.               GetARec:=GetAUserRec;
  1488.               PutARec:=PutAUserRec;
  1489.               Allowed:=10;
  1490.               CASE Cfg.BBS.BBSType OF
  1491.                 btQBBS:
  1492.                   BrowseRecords(f,QBBSUsertype(up^),ExitCode,'USER BROWSER (QBBS)',
  1493.                                 'User name                           Security.lvl    City',
  1494.                                 UserGetStr,UserEditProc1,InitUserBuf,UserIsGreater);
  1495.                 btSBBS:
  1496.                   BrowseRecords(f,QBBSUsertype(up^),ExitCode,'USER BROWSER (SBBS)',
  1497.                                 'User name                           Security.lvl    City',
  1498.                                 UserGetStr,UserEditProc1,InitUserBuf,UserIsGreater);
  1499.               END;
  1500.               GetARec:=DefGetRec;
  1501.               PutARec:=DefPutRec;
  1502.               IF Cfg.BBS.BBSType=btSBBS THEN f4.Close;
  1503.               f3.Close;
  1504.               f2.Close;
  1505.               f.CLOSE;
  1506.               Dispose(ESR, Done);
  1507.             END ELSE
  1508.               AddLog('!', 'Not enough memory to initialize User Editor');
  1509.           END;
  1510.         END;
  1511.       btOpus110:
  1512.         BEGIN
  1513.           If Not (ExistFile(Cfg.BBS.UserFile)) then
  1514.             AskError(8,'No Userfile found',4)
  1515.           Else
  1516.           BEGIN
  1517.             IF MakeOpus110Screen THEN
  1518.             BEGIN
  1519.               f.Open(Cfg.BBS.UserFile,1024,True);
  1520.               Allowed:=10;
  1521.               BrowseRecords(f,up^,ExitCode,'USER BROWSER (OPUS 1.10)',
  1522.                             'User name                           Security.lvl    City',
  1523.                             UserGetStr,UserEditProc3,InitUserBuf,UserIsGreater);
  1524.               f.CLOSE;
  1525.               Dispose(ESR, Done);
  1526.             END ELSE
  1527.               AddLog('!', 'Not enough memory to initialize User Editor');
  1528.           END;
  1529.         END;
  1530.       btRA:
  1531.         BEGIN
  1532.           If Not (ExistFile(Cfg.BBS.UserFile)) then
  1533.             AskError(8,'No Userfile found',4)
  1534.           Else
  1535.           BEGIN
  1536.             IF MakeRAScreen THEN
  1537.             BEGIN
  1538.               f.Open(Cfg.BBS.UserFile,SizeOf(RaUserType)-SizeOf(DiverseType),True);
  1539.               Allowed:=10;
  1540.               BrowseRecords(f,up^,ExitCode,'USER BROWSER (Remote Access 1.11)',
  1541.                             'User name                           Security.lvl    City',
  1542.                             UserGetStr,UserEditProc4,InitUserBuf,UserIsGreater);
  1543.               f.CLOSE;
  1544.               Dispose(ESR, Done);
  1545.             END ELSE
  1546.               AddLog('!', 'Not enough memory to initialize User Editor');
  1547.           END;
  1548.         END;
  1549.       btMax:
  1550.         BEGIN
  1551.           If Not (ExistFile(cfg.BBS.UserFile)) then
  1552.             AskError(8,'No Userfile found',4)
  1553.           Else
  1554.           BEGIN
  1555.             IF MakeMaximusScreen THEN
  1556.             BEGIN
  1557.               f.Open(cfg.BBS.UserFile,SizeOf(MaximusUserType)-SizeOf(DiverseType),True);
  1558.               Allowed:=10;
  1559.               BrowseRecords(f,up^,ExitCode,'USER BROWSER (Maximus 2.0)',
  1560.                             'User name                           Security.lvl    City',
  1561.                             UserGetStr,UserEditProc7,InitUserBuf,UserIsGreater);
  1562.               f.CLOSE;
  1563.               Dispose(ESR, Done);
  1564.             END ELSE
  1565.               AddLog('!', 'Not enough memory to initialize User Editor');
  1566.           END;
  1567.         END;
  1568.       ELSE
  1569.         AskError(8,'Sorry, The UserBrowser does not support your BBS-type',4);
  1570.     END;
  1571.   END;
  1572. {$ELSE}
  1573.   AskError(10, 'Not implemented in Portal of Power/Lite', 2);
  1574. {$ENDIF}
  1575. END;
  1576.  
  1577. END.
  1578.